home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ShareWare OnLine 2
/
ShareWare OnLine Volume 2 (CMS Software)(1993).iso
/
prog
/
gametp20.zip
/
DSOUND.INT
< prev
next >
Wrap
Text File
|
1992-11-05
|
8KB
|
234 lines
Unit Dsound;
{ DSOUND version 1.0 Copyright (C) 1992 Scott D. Ramsay }
{ ramsays@access.digex.com }
{ This unit allows you to play VOC files in the background with a }
{ sound blaster compatible card. The VOC files can be in the heap }
{ space or EMS memory. For EMS memory, VOC files must be under 64k }
{ in size. Heap space voc files can be greater than 64k in size. }
{ DSOUND.TPU can be used freely in commerical and non-commerical }
{ programs. As long as you don't give yourself credit for writing }
{ this portion of the code. When distributing it please include all }
{ files and samples so others may enjoy using the code. Thanks. }
Interface
Uses Dos,LimEMS;
const
ScardHere : boolean = false; { Is set to true if Sound Blaster }
{ card is found. }
n16_block = 4; { largest size of heap VOC file }
{ size = n16block*$fff8 }
type
Psound = ^Tsound;
Tsound = object
sblk : array[0..n16_block-1] of pointer;
size : longint;
blck : byte;
initok : boolean;
constructor init(vocfile:string);
function loadvoc(vocfile:string):boolean; virtual;
function filevoc(var fil:file;bsize:longint):boolean; virtual;
procedure cleanvoc; virtual;
procedure play; virtual;
destructor done; virtual;
end;
PEmsSound = ^TEmsSound;
TEmsSound = object(Tsound)
EMSseg,handle : word;
EMSok : boolean;
constructor init(vocfile:string);
function loadvoc(vocfile:string):boolean; virtual;
procedure cleanvoc; virtual;
procedure play; virtual;
destructor done; virtual;
end;
var
StatusWord : Word; { stores status of voice file }
{ 0 - No sound is playing }
{ FFFF - Sound is playing }
function ScardSetup(portn,Intn:byte): boolean;
function Use_DRV(fn:string):boolean;
procedure PlayVOC(var buffer);
procedure Scard_IO(add:word);
procedure Scard_INT(intno:word);
procedure Scard_stop;
function Scard_pause : integer;
function scard_resume : integer;
{ See Implementation section for description of functions }
implementation
(*************************************************************************)
function Use_DRV(fn:string):boolean;
If you want to use a driver supplied by Sound Blaster instead of
the unit's internal driver, call this function after SCARDSETUP.
fn the file name of the SB driver. Usually CT-VOICE.DRV.
(*************************************************************************)
procedure Scard_IO(add:word);
Called by SCARDSETUP. Sets to the card IO port address.
(*************************************************************************)
procedure Scard_Int(intno:word);
Called by SCARDSETUP. Sets to the card IRQ number.
(*************************************************************************)
procedure Scard_stop;
Stops playing sounds.
(*************************************************************************)
function Scard_pause : integer;
Pauses playing sounds.
returns 0 no error
(*************************************************************************)
function scard_resume : integer;
Resumes playing paused sounds.
returns 0 no error
(*************************************************************************)
function ScardSetup(portn,Intn:byte): boolean;
Inits the DSOUND unit and card. Returns TRUE if card is found.
portn : Port address of Sound card
intn : IRQ number of Sound card
NOTE: set PORTN and INTN to 0 to use BLASTER environment variable
for setting the port and IRQ.
(*************************************************************************)
procedure PlayVOC(var buffer);
Play a voice file. At memory location BUFFER.
(*************************************************************************)
constructor Tsound.init(vocfile:string);
Inits Tsound. Loads voice in memory.
Tsound variables:
sblk Pointers to hold 64k blocks of voice file.
size Size of voice file. set to zero if none, or error
blck number of 64k blocks voice uses.
initok set TRUE if no error loading voice.
(*************************************************************************)
function Tsound.filevoc(var fil:file;bsize:longint):boolean;
Same as Tsound.loadvoc, loads a voc file in a file.
fil A file that is already open and the current file position
is the beginning of voc file.
bsize size of the voice.
This method is used by FLICS.TPU, this method is good if you want
to pool your VOC files to one big file.
See also:
Tsound.loadvoc
(*************************************************************************)
function Tsound.loadvoc(vocfile:string): boolean;
This method loads the voc file into heap memory. Returns TRUE if
successfull.
(*************************************************************************)
procedure Tsound.play;
Take a guess. Plays the sound.
(*************************************************************************)
procedure Tsound.cleanvoc;
Deallocates the sound from heap space
(*************************************************************************)
destructor Tsound.Done;
Calls Tsound.cleanvoc;
(*************************************************************************)
constructor TEmsSound.init(vocfile:string);
Inits TEmsSound. Loads voice in EMS memory.
TEmsSound variables:
EMSseg EMS segment windows address
handle handle to the EMS memory
EMSok TRUE if EMS is ok, and voc file is under 64k
(*************************************************************************)
function TEmsSound.loadvoc(vocfile:string):boolean;
Same as Tsound.loadvoc
Loads a vocfile to EMS memory returns TRUE is successful.
voice file must be under 64k
(*************************************************************************)
function TEmsSound.filevoc
It is inherited from TSound do not call. Not implemented.
(*************************************************************************)
procedure TEmsSound.cleanvoc;
Same as TSound.cleanvoc
Deallocates the sound from EMS memory
(*************************************************************************)
procedure TEmsSound.play;
Plays sound
(*************************************************************************)
destructor TEmsSound.done;
calls TemsSound.cleanvoc
(*************************************************************************)
Note: This unit uses EXITPROC pointer to deallocate its
internal workings. If you use EXITPROC in you program
be sure to chain it.
e.g.
var
OldExitProc : pointer;
procedure MyExitProcedure; far;
begin
{ do my exit coding here }
ExitProc := OldExitProc;
end;
.
.
.
OldExitProc := ExitProc;
ExitProc := @MyExitProcedure;